home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / self / contrib.lha / contrib / 491 / newerX / eventWatcher.self next >
Encoding:
Text File  |  1993-06-06  |  1.2 KB  |  46 lines
  1. "Sun-1.1"
  2.  
  3. "Copyright 1992 Sun Microsystems, Inc. and Stanford University.
  4.  See the LICENSE file for license information."
  5.  
  6. traits userInterface _AddSlotsIfAbsent: ( | ^ eventWatcher = () | )
  7. traits eventWatcher _Define: ( |
  8.     _ parent* = traits clonable.
  9.  
  10.     printString = 'an eventWatcher'.
  11.  
  12.     copyForDisplay: disp SendingTo: t = (
  13.         ((copy sema: semaphore copyBinary) display: disp) target: t ).
  14.  
  15.     watch = ( 
  16.     [ | :exit. event |
  17.       grabEvents.
  18.       event: display nextEvent.
  19.       dispatch: event.
  20.       quitFlag ifTrue: [ exit value ].
  21.       ungrabEvents.
  22.     ] loopExit.
  23.     self ).
  24.  
  25.     dispatch: event = ( (event typeName, ':') sendTo: target With: event ).
  26.  
  27.     "note that grabEvents has to wait for the eventWatcher to get
  28.      an event before it can proceed--when idling, the eventWatcher
  29.      is waiting on X get next event"
  30.     grabEvents = ( sema wait ).
  31.     ungrabEvents = ( sema signal ).
  32.  
  33.     quit = ( quitFlag: true ).
  34. | )
  35.  
  36. prototypes userInterface _AddSlotsIfAbsent: ( | ^ eventWatcher = () | )
  37. eventWatcher _Define: ( |
  38.     _ parent* = traits eventWatcher.
  39.     _ thisObjectPrints = true.
  40.  
  41.     _ sema <- semaphore.
  42.     _ display.
  43.     _ target.
  44.     _ quitFlag <- false.
  45. | )
  46.